home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 6 / Amiga Format AFCD06 (Nov 1996, Issue 90).iso / serious / commercial / cloanto / colortype / rexx / checkfixedfont.ctrx < prev    next >
Text File  |  1996-04-11  |  2KB  |  109 lines
  1. /* ColorType Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: CheckFixedFont.ctrx 1.0 */
  4.  
  5. /**
  6.  This script scans the size and spacing values of all characters, verifying
  7.  whether the font meets the requirements of a "non-proportional" (fixed-width
  8.  characters and fixed-pitch spacing) font. As soon as a character is found
  9.  which does not meet the requirements, its data is displayed.
  10. */
  11.  
  12. IF ARG(1, EXISTS) THEN
  13.     PARSE ARG CTPORT
  14. ELSE
  15.     CTPORT = 'COLORTYPE'
  16.  
  17. IF ~SHOW('P', CTPORT) THEN DO
  18.     IF EXISTS('ColorType:ColorType') THEN DO
  19.         ADDRESS COMMAND 'Run >NIL: ColorType:ColorType'
  20.         DO 30 WHILE ~SHOW('P',CTPORT)
  21.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  22.         END
  23.     END
  24.     ELSE DO
  25.         SAY "ColorType could not be loaded."
  26.         EXIT 10
  27.     END
  28. END
  29.  
  30. IF ~SHOW('P', CTPORT) THEN DO
  31.     SAY 'ColorType Rexx port could not be opened.'
  32.     EXIT 10
  33. END
  34.  
  35. ADDRESS VALUE CTPORT
  36. OPTIONS RESULTS
  37. OPTIONS FAILAT 10000
  38.  
  39.  
  40. LockGUI
  41. GetChar
  42. scnum = RESULT
  43.  
  44. SetChar FIRSTON
  45.  
  46. GetXSize
  47. fixw = RESULT
  48. GetKern
  49. fixp = RESULT
  50. GetSpace
  51. fixp = fixp + RESULT
  52.  
  53. fixw_broken = -1
  54. fixp_broken = -1
  55.  
  56. IF RC = 0 THEN DO
  57.     DO FOREVER
  58.         GetXSize
  59.         w = RESULT
  60.         GetKern
  61.         p = RESULT
  62.         GetSpace
  63.         p = p + RESULT
  64.  
  65.         IF w ~= fixw & fixw_broken < 0 THEN DO
  66.             GetChar
  67.             fixw_broken = RESULT
  68.             fixw_bw = w
  69.         END
  70.  
  71.         IF p ~= fixp & fixp_broken < 0 THEN DO
  72.             GetChar
  73.             fixp_broken = RESULT
  74.             fixp_bp = p
  75.         END
  76.  
  77.         IF fixw_broken >= 0 & fixp_broken >= 0 THEN
  78.             LEAVE
  79.  
  80.         SetChar NEXTON
  81.         IF RC ~= 0 THEN
  82.             LEAVE
  83.     END
  84.     SetChar scnum
  85.  
  86.     msg = '"TEXT = '
  87.  
  88.     IF fixw_broken < 0 THEN
  89.         msg = msg || '""It is a fixed-width font""'
  90.     ELSE DO
  91.         msg = msg || '""It is not a fixed-width font"" ' ||,
  92.               'TEXT = ""(the width of ch. 'fixw_broken' is 'fixw_bw')""'
  93.     END
  94.  
  95.     msg = msg || ' SEPARATOR TEXT = '
  96.  
  97.     IF fixp_broken < 0 THEN
  98.         msg = msg || '""It is a fixed-pitch font""'
  99.     ELSE DO
  100.         msg = msg || '""It is not a fixed-pitch font"" ' ||,
  101.               'TEXT = ""(the pitch of ch. 'fixp_broken' is 'fixp_bp')""'
  102.     END
  103.  
  104.     msg = msg || ' ACTION = OKAY"'
  105.  
  106.     Request '"CheckFixedFont"' msg
  107. END
  108. UnlockGUI
  109.